home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / SMALLTAL / PRINTF_S.CA1 < prev    next >
Text File  |  1990-07-16  |  16KB  |  345 lines
  1. <...has anyone written an sprintf compatible hack for ST-80?>
  2.  
  3. This works in Tek Smalltalk.  I have no idea how it behaves elsewhere.
  4.  
  5. ------ cut here, and at end ------
  6.  
  7. 'From Tektronix Smalltalk-80 version TB2.2.2a of May 05, 1988, 18:14:03. on 5 April 1989 at 12:28:07 pm'!
  8.  
  9. "The following methods implement printf and scanf functionality.  They are intended to be used to ease porting between Smalltalk and C, and for facilitating machine-machine communication.  They are not at all intended as replacements for Smalltalk's printOn: functionality."!
  10.  
  11. '$Header: PrintfScanf.st,v 1.1 89/05/08 10:00:33 jans Exp $'!
  12.  
  13. (Character canUnderstand: #to:) ifFalse:
  14.         [self == nil
  15.                 ifFalse: [self requires: 'CharacterComparing.st']
  16.                 ifTrue: [self notify: 'This code requires the file "CharacterComparing.st"']]!
  17.  
  18. !String methodsFor: 'printing'!
  19.  
  20. formatArgCount
  21.         "Return the number of arguments required/produced if the receiver is interpreted as a printf/scanf format control string."
  22.  
  23.         | nonConsecutive count |
  24.         nonConsecutive _ true.
  25.         count _ 0.
  26.         self do: [:c |
  27.                 c == $%
  28.                         ifTrue:
  29.                                 [nonConsecutive
  30.                                         ifTrue: [count _ count + 1. nonConsecutive _ false]
  31.                                         ifFalse: [count _ count - 1. nonConsecutive _ true]]
  32.                         ifFalse: [nonConsecutive _ true]].
  33.         ^count!
  34.  
  35. printf: args
  36.         "Format and print the receiver with <args> formatted in C style, as described in the UTek manual page for printf(3)."
  37.  
  38.         | aStream |
  39.         aStream _ WriteStream on: String new.
  40.         self printOn: aStream withData: args.
  41.         ^aStream contents!
  42.  
  43. printOn: outStream withData: args
  44.         "Format and print the receiver on <outStream> with <args> formatted in C style, as described in the UTek manual page for printf(3).  This method is designed for producing output suitable for a machine.  Hack 'printArgFrom:to:withData:' to use 'Character value: 25' instead of space if you want numeric columns to line up nicely."
  45.  
  46.         | argStream inStream char |
  47.         argStream _ ReadStream on: args.
  48.         inStream _ ReadStream on: self.
  49.         [inStream atEnd] whileFalse:
  50.                 [(char _ inStream next) == $%
  51.                         ifFalse: [outStream nextPut: char]
  52.                         ifTrue: [self printArgFrom: inStream to: outStream withData: argStream]]! !
  53.  
  54. !String methodsFor: 'converting'!
  55.  
  56. sscanf: string
  57.         "Return a Collection of objects found in <string> as interpreted according to the receiver.  The receiver is assumed to be a conversion control string as specified in the UTek manual page for scanf(3)."
  58.  
  59.         ^self scanf: (ReadStream on: string)!
  60.  
  61. scanf: dataStream
  62.         "Return a Collection of objects found in the Character Stream <dataStream> as interpreted according to the receiver.  The receiver is assumed to be a conversion control string as specified in the UTek manual page for scanf(3)."
  63.  
  64.         | results format char |
  65.         results _ OrderedCollection new.
  66.         format _ ReadStream on: self.
  67.         [format atEnd] whileFalse:
  68.                 [char _ format next.
  69.                 (char == Character space or: [char == Character tab]) ifTrue:
  70.                         [dataStream skipSeparators. format skipSeparators].
  71.                 char == $%
  72.                         ifTrue: [self scanArgFrom: dataStream to: results format: format]
  73.                         ifFalse: [dataStream peekFor: char]].
  74.         ^results! !
  75.  
  76. !String methodsFor: 'private'!
  77.  
  78. printArgFrom: inStream to: outStream withData: argStream
  79.         "Interpret the required number of arguments from <argStream> according to the formatting information in <inStream>.  Place the interpretation on <outStream>.  The interpretation is C printf(3) style, as described in the UTek manual page for printf(3).  <inStream> is assumed to be positioned just past $%, and a complete control string is assumed available.
  80.  
  81.         Return when the conversion control string is consumed.  Leave <inStream> pointing past the last character in the conversion control string.
  82.  
  83.         This code assumes that <inStream> is formatted according to specification, and error checking is minimal.  Unexpected results will be obtained by illegal control strings, or when argument types do not match conversion codes, but it probably won't dump core, like C does in such cases!!"
  84.  
  85.         | ljust plus pound width precision pad char arg argString sci |
  86.         ljust _ plus _ pound _ false.
  87.         width _ 0.
  88.         precision _ SmallInteger maxVal.
  89.         pad _ $ .
  90.         char _ inStream peek.
  91.  
  92.         char == $% ifTrue:
  93.                 [^outStream nextPut: inStream next].
  94.  
  95.         char == $- ifTrue:
  96.                 [ljust _ true.  inStream next.  char _ inStream peek].
  97.  
  98.         char == $  ifTrue:
  99.                 [outStream space.  inStream next.  char _ inStream peek].
  100.  
  101.         char == $+ ifTrue:
  102.                 [plus _ true.  inStream next.  char _ inStream peek].
  103.  
  104.         char == $# ifTrue:
  105.                 [pound _ true.  inStream next.  char _ inStream peek].
  106.  
  107.         char == $* ifTrue:
  108.                 [width _ argStream next.  inStream next.  char _ inStream peek].
  109.         char isDigit ifTrue:
  110.                 [char == $0 ifTrue: [pad _ $0].
  111.                 width _ Integer readFrom: inStream.  char _ inStream peek].
  112.  
  113.         char == $. ifTrue:
  114.                 [inStream next.  char _ inStream peek.
  115.                 char == $*
  116.                         ifTrue: [precision _ argStream next.  inStream next.  char _ inStream peek]
  117.                         ifFalse: [precision _ Integer readFrom: inStream.  char _ inStream peek]].
  118.  
  119.         char == $l ifTrue:      "Ignore long specifier."
  120.                 [inStream next.  char _ inStream peek].
  121.  
  122.         ('feg' includes: char) ifTrue:
  123.                 [arg _ argStream next asFloat.
  124.                 precision _ precision min: 6.
  125.                 argString _ WriteStream on: String new.
  126.                 char == $g ifTrue:
  127.                         [arg absPrintOn: argString digits: precision + 1].
  128.                 char == $f ifTrue:
  129.                         [arg absDecimalPrintOn: argString digits: precision + arg abs log + 1].
  130.                 char == $e ifTrue:
  131.                         [arg absScientificPrintOn: argString digits: precision + 1].
  132.                 argString _ argString contents.
  133.                 arg < 0
  134.                         ifTrue: [argString _ '-', argString]
  135.                         ifFalse: [plus ifTrue: [argString _ '+', argString]].
  136.                 (precision = 0 and: [pound not]) ifTrue:
  137.                         [(argString includes: $e)
  138.                                 ifTrue: ["self halt"]
  139.                                 ifFalse:
  140.                                         [argString _ arg truncated printString]].
  141.                 pound ifTrue:
  142.                         [(argString includes: $e)
  143.                                 ifTrue: ["self halt"]
  144.                                 ifFalse:
  145.                                         [precision - (argString size - (argString indexOf: $.)) timesRepeat:
  146.                                                 [argString _ argString, '0']]].
  147.                 ljust ifTrue: [outStream nextPutAll: argString].
  148.                 width - argString size timesRepeat: [outStream space].
  149.                 ljust ifFalse: [outStream nextPutAll: argString].
  150.                 ^inStream next].
  151.  
  152.         char == $c ifTrue:
  153.                 [arg _ String with: argStream next asCharacter].
  154.  
  155.         char == $s ifTrue:      "Assume the arg is a String or Symbol."
  156.                 [arg _ argStream next asString].
  157.  
  158.         char == $d ifTrue:
  159.                 [arg _ argStream next asInteger printString.
  160.                 plus ifTrue: [arg _ '+', arg]].
  161.  
  162.         char == $u ifTrue:
  163.                 [arg _ argStream next asInteger abs printString].
  164.  
  165.         char == $o ifTrue:
  166.                 [arg _ argStream next asInteger abs printStringRadix: 8.
  167.                 pound ifTrue: [arg _ '0', arg]].
  168.  
  169.         ('xX' includes: char) ifTrue:
  170.                 [arg _ argStream next asInteger abs printStringRadix: 16.
  171.                 pound ifTrue: [arg _ '0x', arg]].
  172.  
  173.         char == $x ifTrue:
  174.                 [1 to: arg size do: [:i |
  175.                         ('ABCDEF' includes: (arg at: i)) ifTrue:
  176.                                 [arg at: i put: ((arg at: i) asciiValue + 16r20) asCharacter]]].
  177.  
  178.         precision _ precision min: arg size.
  179.         ljust ifTrue: [outStream nextPutAll: (arg copyFrom: 1 to: precision)].
  180.         width - precision timesRepeat: [outStream nextPut: pad].
  181.         ljust ifFalse: [outStream nextPutAll: (arg copyFrom: 1 to: precision)].
  182.         ^inStream next!
  183.  
  184. scanArgFrom: dataStream to: collection format: format
  185.         "Add to <collection> an object who's representation is found in <dataStream> interpreted according to the conversion control string in the Stream <format>.  <format> is assumed to be positioned just past a $%, and a complete control string is assumed available.
  186.  
  187.         Return when the conversion control string is consumed.  Leave <format> pointing past the last character in the conversion control string, leave <dataStream> pointing past any width specified in <format>, or at the first character that doesn't make sense for the <format>."
  188.  
  189.         | final width char pos data scanset exclusive return last |
  190.         final _ [:retval |
  191.                 collection add: retval.
  192.                 data == dataStream ifFalse:
  193.                         [dataStream position: dataStream position + data position].
  194.                 ^self].
  195.         width _ 0.
  196.         char _ format peek.
  197.  
  198.         char == $% ifTrue: [^dataStream peekFor: char].
  199.  
  200.         char == $* ifTrue:
  201.                 [format next.
  202.                 char _ format peek.
  203.                 final _ [:retval |
  204.                         data == dataStream ifFalse:
  205.                                 [dataStream position: dataStream position + data position].
  206.                         ^self]].        "Parse, but don't return value."
  207.  
  208.         char isDigit ifTrue: [width _ Integer readFrom: format.  char _ format peek].
  209.         ('slhduoxfeg' includes: char) ifTrue: [dataStream skipSeparators].
  210.         width = 0
  211.                 ifTrue: [data _ dataStream]
  212.                 ifFalse:
  213.                         [pos _ dataStream position.
  214.                         data _ ReadStream on: (dataStream next: width).
  215.                         dataStream position: pos].
  216.  
  217.         char == $s ifTrue:
  218.                 [final value: (data upToSeparator)].
  219.  
  220.         char == $c ifTrue:
  221.                 [width = 0
  222.                         ifTrue: [final value: (String with: data next)]
  223.                         ifFalse: [final value: data contents]].
  224.  
  225.         char == $[ ifTrue:      "What a mess!!"
  226.                 [return _ WriteStream on: (String new: 8).
  227.                 scanset _ IdentitySet new.
  228.                 format next.
  229.                 width = 0 ifTrue: [width _ SmallInteger maxVal].
  230.                 exclusive _ format peekFor: $^.
  231.                 [last _ char. char _ format next. char == $]] whileFalse:
  232.                         [char == $-
  233.                                 ifFalse: [scanset add: char]
  234.                                 ifTrue: [(last to: format next) do: [:c | scanset add: c]]].
  235.                 [data atEnd not
  236.                         and: [(scanset includes: data peek)
  237.                         xor: exclusive]] whileTrue:
  238.                                 [return nextPut: data next].
  239.                 final value: return contents].
  240.  
  241.         ('lh' includes: char) ifTrue: [format next.  char _ format peek].       "ignore long-short flags"
  242.  
  243.         ('DUdu' includes: char) ifTrue:
  244.                 [final value: (Integer readFrom: data)].
  245.  
  246.         ('FEGfeg' includes: char) ifTrue:
  247.                 [final value: (Float readFrom: data)].
  248.  
  249.         ('Oo' includes: char) ifTrue:
  250.                 [final value: (Integer readFrom: data radix: 8)].
  251.  
  252.         ('Xx' includes: char) ifTrue:
  253.                 [final value: (Integer readFrom: data radix: 16)]! !
  254.  
  255. !Float methodsFor: 'private'!
  256.  
  257. absPrintOn: aStream digits: digits 
  258.         "Place a string representation of the receiver on <aStream> using <digits> significant digits."
  259.  
  260.         (self < 1.0e6 and: [self > 1.0e-4])
  261.                 ifTrue: [self absDecimalPrintOn: aStream digits: digits]
  262.                 ifFalse: [self absScientificPrintOn: aStream digits: digits]!
  263.  
  264. absDecimalPrintOn: aStream digits: digits 
  265.         "Place a string representation of the receiver on <aStream> using <digits> significant digits, using decimal notation."
  266.  
  267.         | exp x fuzz |
  268.         "x is myself normalized to (1.0, 10.0), exp is my exponent"
  269.         exp _ self abs < 1.0
  270.                 ifTrue: [(10.0 / self abs) log floor negated]
  271.                 ifFalse: [self abs log floor].
  272.         x _ self abs / (10.0 raisedTo: exp).
  273.         fuzz _ 10.0 raisedTo: 1 - digits.
  274.         "round the last digit to be printed"
  275.         x _ 0.5 * fuzz + x.
  276.         x >= 10.0 ifTrue: "check if rounding has unnormalized x"
  277.                 [x _ x / 10.0.
  278.                 exp _ exp + 1].
  279.         exp < 0 ifTrue: [1 to: 1 - exp do: [:i | aStream nextPut: ('0.000000000000' at: i)]].
  280.         [x >= fuzz] whileTrue: "use fuzz to track significance"
  281.                 [i _ x truncated.
  282.                 aStream nextPut: (48 + i) asCharacter.
  283.                 x _ x - i * 10.0.
  284.                 fuzz _ fuzz * 10.0.
  285.                 exp _ exp - 1.
  286.                 exp = -1 ifTrue: [aStream nextPut: $.]].
  287.         [exp >= -1] whileTrue: 
  288.                 [aStream nextPut: $0.
  289.                 exp _ exp - 1.
  290.                 exp = -1 ifTrue: [aStream nextPut: $.]]!
  291.  
  292. absScientificPrintOn: aStream digits: digits 
  293.         "Place a string representation of the receiver on <aStream> using <digits> significant digits, using scientific notation."
  294.  
  295.         | exp fuzz x q i |
  296.         "x is myself normalized to [1.0, 10.0), exp is my exponent"
  297.         exp _ self abs < 1.0
  298.                 ifTrue: [(10.0 / self abs) log floor negated]
  299.                 ifFalse: [self abs log floor].
  300.         x _ self abs / (10.0 raisedTo: exp).
  301.         fuzz _ 10.0 raisedTo: 1 - digits.
  302.         "round the last digit to be printed"
  303.         x _ 0.5 * fuzz + x.
  304.         x >= 10.0 ifTrue: "check if rounding has unnormalized x"
  305.                 [x _ x / 10.0.
  306.                 exp _ exp + 1].
  307.         q _ exp.
  308.         exp _ 0.
  309.         [x >= fuzz] whileTrue: "use fuzz to track significance"
  310.                 [i _ x truncated.
  311.                 aStream nextPut: (48 + i) asCharacter.
  312.                 x _ x - i * 10.0.
  313.                 fuzz _ fuzz * 10.0.
  314.                 exp _ exp - 1.
  315.                 exp = -1 ifTrue: [aStream nextPut: $.]].
  316.         [exp >= -1] whileTrue: 
  317.                 [aStream nextPut: $0.
  318.                 exp _ exp - 1.
  319.                 exp = -1 ifTrue: [aStream nextPut: $.]].
  320.         aStream nextPut: $e.
  321.         q printOn: aStream! !
  322.  
  323. Transcript cr; show: 'Some examples:'!
  324.  
  325. Transcript cr; show: '''%#x %#X %03o%*.*s'' printf: #(16rABCD 16rEF 5 9 5 ''ghijklmn'') = .', ('%#x %#X %03o%*.*s' printf: #(16rABCD 16rEF 5 9 5 'ghijklmn')), '.'!
  326.  
  327. Transcript cr; show: '''%- 10.4s%.2e'' printf: (Array with: ''abcdefghijkl'' with: Float pi) = .', ('%- 10.4s%.2e' printf: (Array with: 'abcdefghijkl' with: Float pi)), '.'!
  328.  
  329. Transcript cr; show: '''%8.3f'' printf: (Array with: 200 sqrt negated) = .', ('%8.3f' printf: (Array with: 200 sqrt negated)), '.'!
  330.  
  331. Transcript cr; show: '''%c'' printf: #(16r41) = .', ('%c' printf: #(16r41)), '.'!
  332.  
  333. Transcript cr; show: '''%f%2s%s%s%s'' sscanf: ''237.0 this is a test'' = ', ('%f%2s%s%s%s' sscanf: '237.0 this is a test') printString!
  334.  
  335. Transcript cr; show: '''%d%f%s'' sscanf: ''25 54.32e-01 monday'' = ', ('%d%f%s' sscanf: '25 54.32e-01 monday') printString!
  336.  
  337. Transcript cr; show: '''%f%*f %8[A-F0-9]%c%d 0x%x%f'' sscanf: ''12.45 1048.73 AE40Z527 0x75BCD15 34'' = ', ('%f%*f %8[A-F0-9]%c%d 0x%x%f' sscanf: '12.45 1048.73 AE40Z527 0x75BCD15 34') printString!
  338. ------ cut here ------
  339.  
  340.  
  341.                                                            Jan Steinman - N7JDB
  342.                                         Tektronix Electronic Systems Laboratory
  343.                                         Box 500, MS 50-370, Beaverton, OR 97077
  344.                                                 (w)503/627-5881 (h)503/657-7703
  345.